home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / sunpro / sunpro-menubar.el.z / sunpro-menubar.el
Encoding:
Text File  |  1998-05-21  |  6.9 KB  |  235 lines
  1. ;;; sunpro-menubar.el --- Initialize the SunPro menubar
  2.  
  3. ;; Copyright (C) 1993, 1994 Sun Microsystems, Inc
  4.  
  5. ;; Author:    Aaron Endelman <endelman@Eng.Sun.COM>
  6. ;; Maintainer:    Vladimir Ivanovic <vladimir@Eng.Sun.COM>
  7. ;; Created:    93/09/13 15:16:24
  8.  
  9. ;; Keywords:    SunPro menubar initialization
  10.  
  11. ;;; Commentary:
  12. ;;  Creates the default SunPro menubars.
  13.  
  14. ;;; To Do:
  15.  
  16. ;;; Code:
  17.  
  18. (defconst sunpro-menubar
  19.  (purecopy-menubar            ;the simple, new user menubar
  20.   (list
  21.    '("File"
  22.      ["New"            sunpro-new-buffer       t]
  23.      ["Open:"            find-file            t]
  24.      ["Include File:"        insert-file        t]
  25.      "-----"
  26.      ["Save"            save-buffer        t nil]
  27.      ["Save As:"        write-file        t]
  28.      ["Revert..."        revert-buffer        t nil]
  29.      "-----"
  30.      ["Print"                lpr-buffer        t nil]
  31.      "-----"
  32.      ["Close"                delete-frame        t]
  33.      ["Exit XEmacs"        save-buffers-kill-emacs    t]
  34.      )
  35.    
  36.    '("Edit"
  37.      ["Undo"            advertised-undo        t]
  38.      "-----"
  39.      ["Cut"            x-kill-primary-selection   t]
  40.      ["Copy"            x-copy-primary-selection   t]
  41.      ["Paste"            x-yank-clipboard-selection t]
  42.      ["Delete"            x-delete-primary-selection t]
  43.      "-----"
  44.      ["Select Block"        mark-paragraph         t]
  45.      ["Select All"        mark-whole-buffer    t]
  46.      )
  47.    
  48.    '("View"
  49.      ["New View"                make-frame             t]
  50.      "-----"
  51.      ["Split Window"        (split-window)        t]
  52.      ["Unsplit Window"        delete-other-windows    t]
  53.      ["Close Buffer"        (kill-buffer nil)    t nil]
  54.      "-----! before list all buffers"
  55.      ["List All Buffers"     list-buffers        t]
  56.      )
  57.      
  58.    '("Find"
  59.      ["Forward:"        sunpro-search-forward    t]
  60.      ["Backward:"        sunpro-search-backward    t]
  61.      ["And Replace:"        sunpro-query-replace    t]
  62.      )
  63.  
  64.    ;; Copy the options menu from the default menubar
  65.   (car (find-menu-item default-menubar '("Options")))
  66.  
  67.    '("Utilities"
  68.      ["Cancel Command"        (keyboard-quit)    t]
  69.      "-----"
  70.      ["Execute Macro"        call-last-kbd-macro last-kbd-macro]
  71.      ["Start Macro Recording"    start-kbd-macro     (not defining-kbd-macro)]
  72.      ["End Macro Recording"    end-kbd-macro        defining-kbd-macro]
  73.      "-----"
  74.      ["Spell"        ispell-buffer    t]
  75.      ["Sort"        sort-lines    t]
  76.      "-----"
  77.      ["Format Paragraph  "    fill-paragraph    t]
  78.      "-----"
  79.      ["Goto Line:"        goto-line    t]
  80.      )
  81.    
  82.    ;; the following is supposed to be here!  It ensures that the
  83.    ;; Help item is always the rightmost item.
  84.  
  85.     nil        ; the partition: menus after this are flushright
  86.  
  87.     '("Help"    ["About XEmacs..."    about-xemacs        t]
  88.         "-----"
  89.         ["XEmacs WWW Page"    xemacs-www-page        t]
  90.         ["XEmacs FAQ via WWW"    xemacs-www-faq        t]
  91.         "-----"
  92.         ["Info"            info            t]
  93.         ["Describe Mode"    describe-mode        t]
  94.          ["Hyper Apropos..."    hyper-apropos        t]
  95.         ["Command Apropos..."    command-apropos        t]
  96.         ["Full Apropos..."    apropos            t]
  97.         ["List Keybindings"    describe-bindings    t]
  98.         ["Describe Key..."    describe-key        t]
  99.         ["Describe Function..."    describe-function    t]
  100.         ["Describe Variable..."    describe-variable    t]
  101.         "-----"
  102.         ["Unix Manual..."    manual-entry        t]
  103.         ["XEmacs Tutorial"    help-with-tutorial    t]
  104.         ["XEmacs News"        view-emacs-news        t]
  105.         ))))
  106.  
  107. (set-menubar sunpro-menubar)
  108.  
  109. (defconst programmer-menu '(["Programmer Menus" 
  110.                  (toggle-programmer-menus) 
  111.                  :style toggle 
  112.                  :selected programmer-menus-p]
  113.                 ["-----! before save options" nil t]))
  114. (setq save-options-menu-item
  115.       (car (find-menu-item default-menubar '("Options" "Save Options"))))
  116. (delete-menu-item '("Options" "Save Options"))
  117. (add-menu () "Options" (append 
  118.              (cdr (car
  119.                    (find-menu-item default-menubar '("Options"))))
  120.              programmer-menu
  121.              (list save-options-menu-item)))
  122.  
  123. ;;;
  124. ;;; helper commands
  125. ;;;
  126.  
  127. (defun sunpro-new-buffer ()
  128.   (interactive)
  129.   (switch-to-buffer (generate-new-buffer "Untitled")))
  130.  
  131. (defun sunpro-new-window ()
  132.   (interactive)
  133.   (switch-to-buffer-other-frame (generate-new-buffer "Untitled")))
  134.  
  135. (defun sunpro-clone-buffer ()
  136.   (interactive)
  137.     (let
  138.     ((old (current-buffer)))
  139.       (switch-to-buffer (generate-new-buffer (buffer-name old)))
  140.     (insert-buffer old)))
  141.  
  142. (defun sunpro-search-forward ()
  143.   (interactive)
  144.   (if isearch-mode (isearch-repeat-forward)
  145.     (x-isearch-maybe-with-region)))
  146.  
  147. (defun sunpro-search-backward ()
  148.   (interactive)
  149.   (if isearch-mode (isearch-repeat-backward)
  150.     (x-isearch-maybe-with-region t)))
  151.  
  152. (put 'sunpro-search-forward 'isearch-command t)
  153. (put 'sunpro-search-backward 'isearch-command t)
  154.  
  155. (defun sunpro-query-replace ()
  156.   (interactive)
  157.   (call-interactively 'query-replace))
  158.  
  159. (defun sunpro-menu-quit ()
  160.   "Abort minibuffer input if any."
  161.   (while (not (zerop (minibuffer-depth)))
  162.     (abort-recursive-edit)))
  163.  
  164. (defvar programmer-menus-p nil)
  165. (defvar sccs-or-vc-menus 'sccs
  166.   "Choose to use the SCCS or the VC menu.")
  167.  
  168. (defun toggle-programmer-menus ()
  169.   (interactive)
  170.   (if programmer-menus-p
  171.       (progn
  172.     (if (equal sccs-or-vc-menus 'sccs)
  173.         (delete-menu-item '("SCCS"))
  174.       (delete-menu-item '("Version Control")))
  175.     (delete-menu-item '("SPARCworks"))
  176.     (delete-menu-item '("Options" "SPARCworks"))
  177.     (delete-menu-item '("Options" "-----! before save options"))
  178.     (delete-menu-item '("Help" "SPARCworks"))
  179.     (setq programmer-menus-p nil))
  180.     (progn
  181.       (require 'eos-load "sun-eos-load")
  182.       (eos::start)
  183.       (if (equal sccs-or-vc-menus 'sccs)
  184.       (progn
  185.         (delete-menu-item '("Version Control"))
  186.         (require 'sccs)
  187.         (add-menu '() "SCCS" (cdr sccs-menu)))
  188.     (progn
  189.       (require 'vc)
  190.       (delete-menu-item '("SCCS"))
  191.       (add-menu '() "Version Control" vc-default-menu)))
  192.       (setq programmer-menus-p t))))
  193.  
  194. (defun sunpro-build-buffers-menu-hook ()
  195.   "For use as a value of activate-menubar-hook.
  196. This function changes the contents of the \"View\" menu to add
  197. at the end the current set of buffers.  Only the most-recently-used few buffers
  198. will be listed on the menu, for efficiency reasons.  You can control how
  199. many buffers will be shown by setting `buffers-menu-max-size'.
  200. You can control the text of the menu items by redefining the function
  201. `format-buffers-menu-line'."
  202.   (let ((buffer-menu (car (find-menu-item current-menubar '("View"))))
  203.     buffers)
  204.     (if (not buffer-menu)
  205.     nil
  206.       (setq buffer-menu (cdr buffer-menu))
  207.       (setq buffers (buffer-list))
  208.  
  209.       (if (and (integerp buffers-menu-max-size)
  210.            (> buffers-menu-max-size 1))
  211.       (if (> (length buffers) buffers-menu-max-size)
  212.           (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
  213.  
  214.       (setq buffers (build-buffers-menu-internal buffers))
  215.       (setq buffers (append (delq nil buffers)))
  216.       ;; slightly (only slightly) more efficient to not install the menubar
  217.       ;; if it hasn't visibly changed.
  218.       (let ((tail (member "-----! before list all buffers" (cdr buffer-menu)))
  219.         )
  220.     (if tail
  221.         (if (equal buffers (cdr tail))
  222.         t  ; return t meaning "no change"
  223.           (setcdr tail buffers)
  224.           nil)
  225.       ;; only the first time
  226.       (add-menu nil "View" (append buffer-menu
  227.                       '("-----! before list all buffers")
  228.                       buffers))
  229.       nil
  230.       )))))
  231.  
  232. (add-hook 'activate-menubar-hook 'sunpro-build-buffers-menu-hook)
  233.  
  234. ;;; sunpro-menubar.el ends here
  235.